home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software of the Month Club 1996 August
/
Software of the Month Club 1996 August.iso
/
pc
/
os2
/
famtree
/
imgedcom.ftx
< prev
next >
Wrap
Text File
|
1996-05-24
|
15KB
|
503 lines
/*
Family Tree Rexx Script FTX
Copyright (C) 1996 by <Nils Meier>
Please send comments to / Kommentar bitte an
meier2@athene.informatik.uni-bonn.de
<This script imports a family tree from a GEDCOM file
/ Dieses Skript importiert einen Stammbaum aus einer GEDCOM Datei.>
*/
/* ----------------------- Params / Parameter ------------------- */
datasex = 'MW'
datamonth = 'JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC'
crlf = '0d0a'x
IF getLanguage()='Deutsch' THEN DO
header = 'Importieren von GEDCOM-Daten :'
select = 'GEDCOM-Import-Datei angeben:'
fileerror = 'Fehler: Einladen von '
nogedcom = 'Fehler: Keine GEDCOM-Datei '
foundheader = 'HEADER gefunden !'
done = 'Fertig !'
sourceis = 'Quellsystem ist '
sourcedate = 'Hergestellt am '
unexpected = 'Unerwartetes Ende der Datei !'
ignoring = 'Beim Einlesen wurden ignoriert: '
oopsDate = 'Undeutliches Datum : '
oopsSex = 'Undeutliches Geschl : '
oopsID = 'Undeutliche ID : '
importstart = 'Starte jetzt Berechnung des Stammbaumes !'crlf'Die letzte Person aus der GEDCOM-Datei wird Ursprung :'
END
ELSE DO
header = 'Importing from GEDCOM :'
select = 'Select GEDCOM file for import:'
fileerror = 'Error: Reading from '
nogedcom = 'Error: No GEDCOM file '
foundheader = 'Found HEADER !'
done = 'Done !'
sourceis = 'Source system is '
sourcedate = 'Produced at '
unexpected = 'Unexpected end of file !'
ignoring = 'Had to ignore during load:'
oopsDate = 'Ambiguous Date : '
oopsSex = 'Ambiguous Sex : '
oopsID = 'Ambiguous ID : '
importstart = 'Starting Calculation of family tree !'crlf'Last person in GEDCOM-file becomes Origin :'
END
/* ----------------- Display Header / Kopf der Ausgabe ------------- */
SAY(header||DATE())
SAY('')
/* ------------------- Open file / Datei oeffnen ---------------- */
file=getFileName(select,'*.GED')
IF (file='') THEN DO
SAY(done)
RETURN
END
rc=LINEIN(file,1,0)
rc=LINES(file)
IF (rc=0) THEN DO
SAY(fileerror||file)
RETURN
END
/* -------------- Header of GEDCOM / Kopf von GEDCOM -------------- */
input=LINEIN(file)
PARSE VAR input lev tag
IF (lev<>0)|(tag<>'HEAD') THEN DO
SAY(nogedcom||file||' (Expected 0 HEAD)')
RETURN
END
SAY(foundheader)
rc=inputFromGedcom()
DO FOREVER
PARSE VAR input lev tag value
SELECT
WHEN rc<>'' THEN LEAVE
WHEN lev='0' THEN LEAVE
WHEN tag='SOUR' THEN SAY(sourceis||'"'||value||'"')
WHEN tag='DATE' THEN SAY(sourcedate||'"'||value||'"')
OTHERWISE NOP
END
rc=waitLev(1)
END
SAY('')
IF rc<>'' THEN DO
SAY(rc)
RETURN
END
/* ---- Read Persons&Families / Personen und Familien einlesen --- */
PIgnored=''
FIgnored=''
SIgnored=''
DO FOREVER
PARSE VAR input lev tag1 tag2 rest
/* Check for INDI & FAM / Suchen nach INDI & FAM */
SELECT
WHEN rc<>'' THEN LEAVE
WHEN tag2='INDI' THEN rc=readPerson()
WHEN tag2='FAM' THEN rc=readFamily()
WHEN tag1='TRLR' THEN LEAVE
OTHERWISE DO
IF WORDPOS(tag2,SIgnored)=0 THEN SIgnored=SIgnored tag2
rc=waitLev(0)
END
END
/* Next Datapacket / Naechster Datensatz */
END
SAY('')
/* ------------------ End of Import / Ende des Imports --------------- */
IF rc='' THEN DO
SAY(ignoring '(Structs)')
SAY(SIgnored)
SAY('')
SAY(ignoring '(in INDI)')
SAY(PIgnored)
SAY('')
SAY(ignoring '(in FAM)')
SAY(FIgnored)
SAY('')
SAY(importstart)
SAY(importDone())
SAY(done)
END
ELSE
SAY(rc)
RETURN
/* =============== Read Functions / Lesefunktionen =============== */
/* ------------- Read Person / Person einlesen ------------------ */
readPerson:
id=WORD(input,2) /* Needed for Ambiguous */
PID =calcID(id)
PAddr =''
PNote =''
IF PID=0 THEN RETURN(waitLev(0))
rc=importPerson()
ok=setPID(PID)
rc=inputFromGedcom() /* input = lev tag value */
DO FOREVER
lev = WORD(input,1)
tag = WORD(input,2)
value=SUBWORD(input,3)
/* ---- Take data / Daten übernehmen --- */
SELECT
/*-------------------------------------------*/
WHEN rc<>'' THEN RETURN(rc||'('||id||')')
WHEN lev=0 THEN LEAVE
/*-------------------------------------------*/
WHEN tag='NAME' THEN DO
PARSE VAR value fname1 '/' name '/' fname2
ok=setName(STRIP(name))
ok=setFirstName(STRIP(fname1||fname2))
rc=waitLev(1)
END
/*-------------------------------------------*/
WHEN tag='SEX' THEN DO
ok=setSex(calcSex(value))
rc=waitLev(1)
END
/*-------------------------------------------*/
WHEN tag='BIRT' THEN DO
rc=inputFromGedcom() /* input = lev tag value */
DO FOREVER
lev=WORD(input,1)
tag=WORD(input,2)
SELECT
WHEN rc<>'' THEN LEAVE
WHEN lev<=1 THEN LEAVE
WHEN tag='DATE' THEN ok=setBirthDate(calcDate(SUBWORD(input,3)))
WHEN tag='PLAC' THEN ok=setBirthPlace(SUBWORD(input,3))
OTHERWISE NOP
END
rc=waitLev(2)
END
END
/*-------------------------------------------*/
WHEN tag='DEAT' THEN DO
rc=inputFromGedcom() /* input = lev tag value */
DO FOREVER
lev=WORD(input,1)
tag=WORD(input,2)
SELECT
WHEN rc<>'' THEN LEAVE
WHEN lev<=1 THEN LEAVE
WHEN tag='DATE' THEN ok=setDeathDate(calcDate(SUBWORD(input,3)))
WHEN tag='PLAC' THEN ok=setDeathPlace(SUBWORD(input,3))
OTHERWISE NOP
END
rc=waitLev(2)
END
END
/*-------------------------------------------*/
WHEN tag='PHOT' THEN DO
ok=setPicture(value)
rc=waitLev(1)
END
/*-------------------------------------------*/
WHEN tag='OCCU' THEN DO
ok=setOccupation(value)
rc=waitLev(1)
END
/*-------------------------------------------*/
WHEN tag='ADDR' THEN DO
addr=value
rc=inputFromGedcom() /* input = lev tag value */
DO FOREVER
lev=WORD(input,1)
tag=WORD(input,2)
SELECT
WHEN rc<>'' THEN LEAVE
WHEN lev<=1 THEN LEAVE
WHEN tag='CONT' THEN addr=addr||','||SUBWORD(input,3)
WHEN tag='PHON' THEN addr=addr||','||SUBWORD(input,3)
OTHERWISE NOP
END
rc=waitLev(2)
END
IF PAddr<>'' THEN PAddr=PAddr||','
PAddr=PAddr||addr
END
/*-------------------------------------------*/
WHEN tag='PHON' THEN DO
IF PAddr<>'' THEN PAddr=PAddr||','
PAddr=PAddr||value
rc=waitLev(1)
END
/*-------------------------------------------*/
WHEN tag='NOTE' THEN DO
PNote=value
rc=inputFromGedcom() /* input = lev tag value */
DO FOREVER
lev=WORD(input,1)
tag=WORD(input,2)
SELECT
WHEN rc<>'' THEN LEAVE
WHEN lev<=1 THEN LEAVE
WHEN tag='CONT' THEN PNote=PNote||crlf||SUBWORD(input,3)
OTHERWISE NOP
END
rc=waitLev(2)
END
END
/*-------------------------------------------*/
/*
WHEN tag='FAMC' THEN DO
PChildren=PChildren value
rc=waitLev(1)
END
/*-------------------------------------------*/
WHEN tag='FAMS' THEN DO
PSpouses=PSpouses value
rc=waitLev(1)
END
*/
/*-------------------------------------------*/
OTHERWISE DO
IF WORDPOS(tag,PIgnored)=0 THEN PIgnored=PIgnored tag
rc=waitLev(1)
END
/*-------------------------------------------*/
END
END
ok=setAddress(PAddr)
ok=setMemo(PNote)
RETURN('')
/* ------------- Read Family / Familie einlesen ------------------ */
readFamily:
id=WORD(input,2) /* Needed for Ambiguous */
FID =calcID(id)
IF FID=0 THEN RETURN(waitLev(0))
rc=importFamily()
ok=setFID(FID)
rc=inputFromGedcom() /* input = lev tag value */
DO FOREVER
lev = WORD(input,1)
tag = WORD(input,2)
value=SUBWORD(input,3)
/* ---- Take data / Daten übernehmen --- */
SELECT
/*-------------------------------------------*/
WHEN rc<>'' THEN RETURN(rc||'('||id||')')
WHEN lev=0 THEN LEAVE
/*-------------------------------------------*/
WHEN tag='HUSB' THEN DO
ok=importAddPartner(calcID(value))
rc=waitLev(1)
END
/*-------------------------------------------*/
WHEN tag='WIFE' THEN DO
ok=importAddPartner(calcID(value))
rc=waitLev(1)
END
/*-------------------------------------------*/
WHEN tag='MARR' THEN DO
rc=inputFromGedcom() /* input = lev tag value */
DO FOREVER
lev=WORD(input,1)
tag=WORD(input,2)
SELECT
WHEN rc<>'' THEN LEAVE
WHEN lev<=1 THEN LEAVE
WHEN tag='DATE' THEN ok=setMarriageDate(calcDate(SUBWORD(input,3)))
WHEN tag='PLAC' THEN ok=setMarriagePlace(SUBWORD(input,3))
OTHERWISE NOP
END
rc=waitLev(2)
END
END
/*-------------------------------------------*/
WHEN tag='DIV' THEN DO
rc=inputFromGedcom() /* input = lev tag value */
DO FOREVER
lev=WORD(input,1)
tag=WORD(input,2)
SELECT
WHEN rc<>'' THEN LEAVE
WHEN lev<=1 THEN LEAVE
WHEN tag='DATE' THEN ok=setDivorceDate(calcDate(SUBWORD(input,3)))
OTHERWISE NOP
END
rc=waitLev(2)
END
END
/*-------------------------------------------*/
WHEN tag='CHIL' THEN DO
ok=importAddChild(calcID(value))
rc=waitLev(1)
END
/*-------------------------------------------*/
OTHERWISE DO
IF WORDPOS(tag,FIgnored)=0 THEN FIgnored=FIgnored tag
rc=waitLev(1)
END
/*-------------------------------------------*/
END
END
RETURN('')
/* =============== Auxilary Functions / Hilfsfunktionen =============== */
/* ------------- Ignore SubTags / SubTags ignorieren ---------------- */
waitLev:
ARG u
DO FOREVER
rc=inputFromGedcom()
IF rc<>'' THEN RETURN(rc)
IF WORD(input,1)<=u THEN RETURN('')
END
/* ------------ Read GedcomLine / GedcomZeile einlesen ------------- */
inputFromGedcom:
IF LINES(file)=0 THEN RETURN(unexpected)
input=LINEIN(file)
RETURN('')
/* ---------------- Calculate ID / ID berechnen -------------------- */
calcID:
i=SPACE(TRANSLATE(ARG(1),'','@IF'),0)
IF (DATATYPE(i)='NUM')&(i>0) THEN RETURN(i)
SAY(oopsID||id||' ('||ARG(1)||')')
RETURN(0)
/* --------- Calculate Sex (0/1/2) / Geschlecht berechnen ----------- */
calcSex:
t=STRIP(ARG(1))
SELECT
WHEN t='' THEN RETURN(0)
WHEN ABBREV(t,'M') THEN RETURN(1)
WHEN ABBREV(t,'F') THEN RETURN(2)
WHEN ABBREV(t,'m') THEN RETURN(1)
WHEN ABBREV(t,'f') THEN RETURN(2)
WHEN ABBREV(t,'W') THEN RETURN(2)
WHEN ABBREV(t,'w') THEN RETURN(2)
OTHERWISE NOP
END
SAY(oopsSex||id||' ('||ARG(1)||')')
RETURN(0)
/* --------------- Calculate Date / Datum berechnen ---------------- */
calcDate:
/* ------------- '' --------------------- */
IF ARG(1)='' THEN RETURN('0.0.0')
/* -------------- PARSE ----------------- */
date=TRANSLATE(ARG(1),'00','_?')
SELECT
WHEN POS('-',date)>0 THEN PARSE VAR date day '-' month '-' year
WHEN POS('.',date)>0 THEN PARSE VAR date day '.' month '.' year
WHEN POS('/',date)>0 THEN PARSE VAR date month '/' day '/' year
OTHERWISE PARSE VAR date day ' ' month ' ' year
END
year=SUBSTR(year,1,4)
daytype =DATATYPE(day)
monthtype=DATATYPE(month)
yeartype =DATATYPE(year)
/* ----- 'dd mm yyyy' ------------------- */
IF (daytype='NUM')&(monthtype='NUM')&(yeartype='NUM') THEN DO
IF (month>12)&(month<32) THEN RETURN(month||'.'||day||'.'||year)
ELSE RETURN(day||'.'||month||'.'||year)
END
/* ----- 'dd MMM yyyy' ------------------- */
IF (daytype='NUM')&(yeartype='NUM') THEN DO
p=WORDPOS(month,datamonth)
IF (p>0) THEN RETURN(day||'.'||p||'.'||year)
END
/* ----- 'dd MMM' ----------------------- */
IF (daytype='NUM')&(monthtype='CHAR')&(year='') THEN DO
p=WORDPOS(month,datamonth)
IF (p>0) THEN RETURN(day||'.'||p||'.'||0)
END
/* ----- 'dd mm' ------------------------ */
IF (daytype='NUM')&(monthtype='NUM')&(year='') THEN
RETURN(day||'.'||month||'.'||year)
/* ----- 'dd __ yyyy' ------------------- */
IF (daytype='NUM')&(month='')&(yeartype='NUM') THEN
RETURN(day||'.'||0||'.'||year)
date=DELWORD(TRANSLATE(date,'','-/.'),4)
dcount =WORDS(date)
datetype=DATATYPE(date)
/* ----- '__ __ yyyy' ------------------- */
IF (dcount=1)&(datetype='NUM') THEN
RETURN(0||'.'||0||'.'||date)
/* ----- '__ MMM __' ---------------- */
IF (dcount=1) THEN DO
p=WORDPOS(date,datamonth)
if (p>0) THEN RETURN(0||'.'||p||'.'||0)
END
word1 =WORD(date,1)
word2 =WORD(date,2)
word1type=DATATYPE(word1)
word2type=DATATYPE(word2)
/* ----- '__ mm|MMM YYYY' ---------------- */
IF (dcount=2)&(word2type='NUM') THEN DO
IF (word1type='NUM')&(word1<13) THEN
RETURN(0||'.'||word1||'.'||word2)
p=WORDPOS(word1,datamonth)
IF p>0 THEN
RETURN(0||'.'||p||'.'||word2)
END
/* ----- ???????????? ------------------- */
SAY(oopsDate||id||' ('||ARG(1)||')')
return('0||'.'||0||'.'||0')